home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / vbkontrol.exe / VBDLL15D.ZIP / SERVER.FR_ / SERVER.FR
Text File  |  1995-03-08  |  8KB  |  241 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "Server"
  4.    ClientHeight    =   4680
  5.    ClientLeft      =   1224
  6.    ClientTop       =   1536
  7.    ClientWidth     =   5268
  8.    Height          =   5208
  9.    Left            =   1188
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   4680
  12.    ScaleWidth      =   5268
  13.    Top             =   1044
  14.    Visible         =   0   'False
  15.    Width           =   5340
  16.    Begin Timer Timer1 
  17.       Enabled         =   0   'False
  18.       Interval        =   10
  19.       Left            =   4404
  20.       Top             =   264
  21.    End
  22.    Begin FUNCTION VBFunctionCtl 
  23.       Declaration     =   "DecToHex(b10&) As Variant|InStrRev(HayStk$, Needle$) As Integer|strrev(stparm$)|TypeTestStk(fnd%, lng&,sng!, rl#, st$, fnd2 as integer, lng2 as long, sng2 as single, rl2 as double, st2 as string, StToDate As Variant, DateToSt As Variant) as string|UnloadVbLib(AutoStarted%)|HexToDec (hx$) As Variant||"
  24.       Left            =   3444
  25.       Top             =   264
  26.    End
  27.    Begin FUNCTION VBFunctionCallCtl 
  28.       Declaration     =   "ShowForm()|TypeTest$ (fnd%, lng&, sng!, rl#, st$, fnd2 As Integer, lng2 As Long, sng2 As Single, rl2 As Double, st2 As String, stlen As String * 10, StToDate As Variant, DateToSt As Variant)||"
  29.       Left            =   456
  30.       Top             =   216
  31.    End
  32.    Begin ListBox List1 
  33.       FontBold        =   -1  'True
  34.       FontItalic      =   0   'False
  35.       FontName        =   "MS Sans Serif"
  36.       FontSize        =   6.6
  37.       FontStrikethru  =   0   'False
  38.       FontUnderline   =   0   'False
  39.       Height          =   3456
  40.       Left            =   72
  41.       TabIndex        =   0
  42.       Top             =   852
  43.       Width           =   5172
  44.    End
  45.    Begin Menu mnuCallProc1 
  46.       Caption         =   "&Clear"
  47.    End
  48.    Begin Menu mnuTest 
  49.       Caption         =   "&Test"
  50.    End
  51. End
  52.  
  53. Sub Form_Load ()
  54.     'if running under vb, display
  55.     Dim te As TASKENTRY
  56.     te.dwSize = Len(te)
  57.     bok% = TaskFindHandle(te, GetCurrentTask())
  58.     If bok% = False Then Exit Sub
  59.     If Left$(te.szModule, 3) = "VB" + Chr$(0) Then Me.Show
  60. End Sub
  61.  
  62. Sub Form_Unload (Cancel As Integer)
  63.         If RecFormLoaded = True Then
  64.             Unload Form2
  65.         End If
  66.     End
  67. End Sub
  68.  
  69. Sub mnuCallProc1_Click ()
  70.     List1.Clear
  71.  
  72.  
  73. End Sub
  74.  
  75. Sub mnuTest_Click ()
  76.     rv = HexToDec("f001")
  77. End Sub
  78.  
  79. Sub ShowForm ()
  80.     Form2.Show
  81.  
  82. End Sub
  83.  
  84. Sub Timer1_Timer ()
  85.     timer1.Enabled = True
  86.     Unload Me
  87.     End
  88. End Sub
  89.  
  90. Function TypeTestStk$ (fnd%, lng&, sng!, rl#, st$, fnd2 As Integer, lng2 As Long, sng2 As Single, rl2 As Double, st2 As String, StToDate, DateToSt)
  91.         
  92.         List1.AddItem Str$(fnd%)
  93.         List1.AddItem Str$(lng&)
  94.         List1.AddItem Str$(sng!)
  95.         List1.AddItem Str$(rl#)
  96.         List1.AddItem st$
  97.         List1.AddItem Str$(fnd2)
  98.         List1.AddItem Str$(lng2)
  99.         List1.AddItem Str$(sng2)
  100.         List1.AddItem Str$(rl2)
  101.         List1.AddItem st2
  102.         List1.AddItem StToDate
  103.         List1.AddItem Format$(DateToSt, "General Date")
  104.  
  105.  
  106.         fnd% = 9000
  107.         lng& = 800
  108.         sng! = 70.7
  109.         rl# = 60.06
  110.         st$ = "1string_string1"
  111.         fnd2 = 1
  112.         lng2 = 20
  113.         sng2 = 30.3
  114.         rl2 = 40.04
  115.         st2 = "string2_2string"
  116.         TypeTestStk$ = "stringret"
  117.         StToDate = Date
  118.         DateToSt = "January 16, 1995"
  119.  
  120. End Function
  121.  
  122. Sub VBFunctionCallCtl_CallProc (ParmPnt As Long, FunctionName As String)
  123.  
  124. 'CallProc Event Code for TypeTest using fixed parm functions.
  125. Select Case FunctionName
  126.     
  127.     Case "TypeTest"
  128.         Dim TypeTestReturnVal As String
  129.         Dim Parm As TypeTestType
  130.         ErrCode% = CopyParmsToVB(Parm, ParmPnt)
  131.         TypeTestReturnVal = TypeTest(Parm.fnd, Parm.lng, Parm.sng, Parm.rl, Parm.st, Parm.fnd2, Parm.lng2, Parm.sng2, Parm.rl2, Parm.st2, Parm.stlen, Parm.StToDate, Parm.DateToSt)
  132.         ErrCode% = CopyParmsFromVB(Parm, ParmPnt, TypeTestReturnVal)
  133.  
  134.     Case "ShowForm"
  135.         Call ShowForm
  136.  
  137. End Select
  138. End Sub
  139.  
  140. Sub VBFunctionCtl_CallProc (ParmPnt As Long, FunctionName As String)
  141.  
  142. Select Case FunctionName
  143.     Case "DecToHex"
  144.         Dim DecToHexReturnVal As Variant
  145.         ErrCode% = VCopyToDecToHex(b10&, ParmPnt)
  146.         DecToHexReturnVal = DecToHex(b10&)
  147.         ErrCode% = VCopyFromDecToHex(b10&, ParmPnt, DecToHexReturnVal)
  148.     Case "HexToDec"
  149.         Dim HexToDecReturnVal As Variant
  150.         ErrCode% = VCopyToHexToDec(hx$, ParmPnt)
  151.         HexToDecReturnVal = HexToDec(hx$)
  152.         ErrCode% = VCopyFromHexToDec(hx$, ParmPnt, HexToDecReturnVal)
  153.     Case "InStrRev"
  154.         Dim InStrRevReturnVal As Integer
  155.         ErrCode% = VCopyToInStrRev(HayStk$, Needle$, ParmPnt)
  156.         InStrRevReturnVal = InStrRev(HayStk$, Needle$)
  157.         ErrCode% = VCopyFromInStrRev(HayStk$, Needle$, ParmPnt, InStrRevReturnVal)
  158.     Case "strrev"
  159.         ErrCode% = VCopyTostrrev(stparm$, ParmPnt)
  160.         Call strrev(stparm$)
  161.         ErrCode% = VCopyFromstrrev(stparm$, ParmPnt, 0)
  162.     Case "TypeTestStk"
  163.         Dim TypeTestStkReturnVal As String
  164.         Dim fnd2 As Integer
  165.         Dim lng2 As Long
  166.         Dim sng2 As Single
  167.         Dim rl2 As Double
  168.         Dim st2 As String
  169.         Dim StToDate As Variant
  170.         Dim DateToSt As Variant
  171.         ErrCode% = VCopyToTypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt, ParmPnt)
  172.         TypeTestStkReturnVal = TypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt)
  173.         ErrCode% = VCopyFromTypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt, ParmPnt, TypeTestStkReturnVal)
  174.     Case "UnloadVbLib"
  175.         ErrCode% = CopyParmsToVB(AutoStarted%, ParmPnt)
  176.         'If AutoStarted% = True Then
  177.             timer1.Enabled = True
  178.         'End If
  179. End Select
  180.  
  181. 'If FunctionName = "UnloadVbLib" Then
  182. '    ErrCode% = CopyParmsToVB(AutoStarted%, ParmPnt)
  183. '    'If AutoStarted% = True Then
  184. '        timer1.Enabled = True
  185. '    'End If
  186. '    Exit Sub
  187. 'End If
  188. '
  189. ''CallProc Event Code for HexToDec using variable parm functions.
  190. 'If FunctionName = "HexToDec" Then
  191. '    Dim HexToDecReturnVal As Variant
  192. '    ErrCode% = VCopyToHexToDec(hx$, ParmPnt)
  193. '    HexToDecReturnVal = HexToDec(hx$)
  194. '    ErrCode% = VCopyFromHexToDec(hx$, ParmPnt, HexToDecReturnVal)
  195. 'End If
  196. '
  197. '
  198. ''CallProc Event Code for DecToHex using variable parm functions.
  199. 'If FunctionName = "DecToHex" Then
  200. '    Dim DecToHexReturnVal As Variant
  201. '    ErrCode% = VCopyToDecToHex(b10&, ParmPnt)
  202. '    DecToHexReturnVal = DecToHex(b10&)
  203. '    ErrCode% = VCopyFromDecToHex(b10&, ParmPnt, DecToHexReturnVal)
  204. 'End If
  205. '
  206. '
  207. ''CallProc Event Code for TypeTestStk using variable parm functions.
  208. 'If FunctionName = "TypeTestStk" Then
  209. '    Dim TypeTestStkReturnVal As String
  210. '    Dim fnd2 As Integer
  211. '    Dim lng2 As Long
  212. '    Dim sng2 As Single
  213. '    Dim rl2 As Double
  214. '    Dim st2 As String
  215. '    Dim StToDate As Variant
  216. '    Dim DateToSt As Variant
  217. '    ErrCode% = VCopyToTypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt, ParmPnt)
  218. '    TypeTestStkReturnVal = TypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt)
  219. '    ErrCode% = VCopyFromTypeTestStk(fnd%, lng&, sng!, rl#, st$, fnd2, lng2, sng2, rl2, st2, StToDate, DateToSt, ParmPnt, TypeTestStkReturnVal)
  220. 'End If
  221. '
  222. ''CallProc Event Code for strrev using variable parm functions.
  223. 'If FunctionName = "strrev" Then
  224. '    ErrCode% = VCopyTostrrev(stparm$, ParmPnt)
  225. '    Call strrev(stparm$)
  226. '    ErrCode% = VCopyFromstrrev(stparm$, ParmPnt, 0)
  227. 'End If
  228. '
  229. ''CallProc Event Code for InStrRev using variable parm functions.
  230. 'If FunctionName = "InStrRev" Then
  231. '    Dim InStrRevReturnVal As Integer
  232. '    ErrCode% = VCopyToInStrRev(HayStk$, Needle$, ParmPnt)
  233. '    InStrRevReturnVal = InStrRev(HayStk$, Needle$)
  234. '    ErrCode% = VCopyFromInStrRev(HayStk$, Needle$, ParmPnt, InStrRevReturnVal)
  235. 'End If
  236. '
  237.  
  238. End Sub
  239.  
  240.  
  241.